home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / execswp.com / EXECSWAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-04-04  |  3.9 KB  |  125 lines
  1. {
  2. Copyright (c) 1988 TurboPower Software
  3. May be used freely as long as due credit is given
  4. Version 1.1 - 3/15/89
  5.   save and restore EMS page map
  6. Version 1.2 - 3/29/89
  7.   add more compiler directives (far calls off, boolean short-circuiting)
  8.   add UseEmsIfAvailable to disable EMS usage when desired
  9. }
  10.  
  11. {$R-,S-,F-,O-,I-,B-}
  12.  
  13. unit ExecSwap;
  14.   {-Memory-efficient DOS EXEC call}
  15. interface
  16.  
  17. const
  18.   UseEmsIfAvailable : Boolean = True;     {True to use EMS if available}
  19.   BytesSwapped : LongInt = 0;             {Bytes to swap to EMS/disk}
  20.   EmsAllocated : Boolean = False;         {True when EMS allocated for swap}
  21.   FileAllocated : Boolean = False;        {True when file allocated for swap}
  22.  
  23. function ExecWithSwap(Path, CmdLine : String) : Word;
  24.   {-DOS EXEC supporting swap to EMS or disk}
  25.  
  26. function InitExecSwap(LastToSave : Pointer; SwapFileName : String) : Boolean;
  27.   {-Initialize for swapping, returning TRUE if successful}
  28.  
  29. procedure ShutdownExecSwap;
  30.   {-Deallocate swap area}
  31.  
  32. implementation
  33.  
  34. var
  35.   EmsHandle : Word;               {Handle of EMS allocation block}
  36.   FrameSeg : Word;                {Segment of EMS page frame}
  37.   FileHandle : Word;              {DOS handle of swap file}
  38.   SwapName : String[80];          {ASCIIZ name of swap file}
  39.   SaveExit : Pointer;             {Exit chain pointer}
  40.  
  41.   {$L EXECSWAP}
  42.   function ExecWithSwap(Path, CmdLine : String) : Word; external;
  43.   procedure FirstToSave; external;
  44.   function AllocateSwapFile : Boolean; external;
  45.   procedure DeallocateSwapFile; external;
  46.  
  47.   {$F+}     {These routines could be interfaced for general use}
  48.   function EmsInstalled : Boolean; external;
  49.   function EmsPageFrame : Word; external;
  50.   function AllocateEmsPages(NumPages : Word) : Word; external;
  51.   procedure DeallocateEmsHandle(Handle : Word); external;
  52.   function DefaultDrive : Char; external;
  53.   function DiskFree(Drive : Byte) : LongInt; external;
  54.  
  55.   procedure ExecSwapExit;
  56.   begin
  57.     ExitProc := SaveExit;
  58.     ShutdownExecSwap;
  59.   end;
  60.   {$F-}
  61.  
  62.   procedure ShutdownExecSwap;
  63.   begin
  64.     if EmsAllocated then begin
  65.       DeallocateEmsHandle(EmsHandle);
  66.       EmsAllocated := False;
  67.     end else if FileAllocated then begin
  68.       DeallocateSwapFile;
  69.       FileAllocated := False;
  70.     end;
  71.   end;
  72.  
  73.   function PtrDiff(H, L : Pointer) : LongInt;
  74.   type
  75.     OS = record O, S : Word; end;   {Convenient typecast}
  76.   begin
  77.     PtrDiff := (LongInt(OS(H).S) shl 4+OS(H).O)-
  78.                (LongInt(OS(L).S) shl 4+OS(L).O);
  79.   end;
  80.  
  81.   function InitExecSwap(LastToSave : Pointer;
  82.                         SwapFileName : String) : Boolean;
  83.   const
  84.     EmsPageSize = 16384;            {Bytes in a standard EMS page}
  85.   var
  86.     PagesInEms : Word;              {Pages needed in EMS}
  87.     BytesFree : LongInt;            {Bytes free on swap file drive}
  88.     DriveChar : Char;               {Drive letter for swap file}
  89.   begin
  90.     InitExecSwap := False;
  91.  
  92.     if EmsAllocated or FileAllocated then
  93.       Exit;
  94.     BytesSwapped := PtrDiff(LastToSave, @FirstToSave);
  95.     if BytesSwapped <= 0 then
  96.       Exit;
  97.     SaveExit := ExitProc;
  98.     ExitProc := @ExecSwapExit;
  99.  
  100.     if UseEmsIfAvailable and EmsInstalled then begin
  101.       PagesInEms := (BytesSwapped+EmsPageSize-1) div EmsPageSize;
  102.       EmsHandle := AllocateEmsPages(PagesInEms);
  103.       if EmsHandle <> $FFFF then begin
  104.         EmsAllocated := True;
  105.         FrameSeg := EmsPageFrame;
  106.         if FrameSeg <> 0 then begin
  107.           InitExecSwap := True;
  108.           Exit;
  109.         end;
  110.       end;
  111.     end;
  112.     if Length(SwapFileName) <> 0 then begin
  113.       SwapName := SwapFileName+#0;
  114.       if Pos(':', SwapFileName) = 2 then
  115.         DriveChar := Upcase(SwapFileName[1])
  116.       else
  117.         DriveChar := DefaultDrive;
  118.       BytesFree := DiskFree(Byte(DriveChar)-$40);
  119.       FileAllocated := (BytesFree > BytesSwapped) and AllocateSwapFile;
  120.       if FileAllocated then
  121.         InitExecSwap := True;
  122.     end;
  123.   end;
  124. end.
  125.